// OpentTxl-C Version 11 parser
// J.R. Cordy, Jan 2023

// Copyright 2023, James R. Cordy and others

// Permission is hereby granted, free of charge, to any person obtaining a copy of this software 
// and associated documentation files (the “Software”), to deal in the Software without restriction, 
// including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, 
// and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, 
// subject to the following conditions:

// The above copyright notice and this permission notice shall be included in all copies 
// or substantial portions of the Software.

// THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 
// INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE 
// AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, 
// DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

// The TXL parser.
// Uses a top-down, recursive descent algorithm to parse the array of tokens produced by the scanner 
// according to the TXL or object language grammar to produce a parse tree instance of the grammar tree.
// The algorithm walks the grammar tree matching input tokens to terminal nodes (literals, ids, numbers, ...), 
// sequences to order nodes, and alternatives to choose nodes. When a sequence element fails to match,
// backtracking retries previous element choices one by one to exhaustively explore alternatives.
// Backtracking is artificially limited to help avoid lengthy parses.

// Modification Log

// v11.0 Initial revision, adapted from OpenTxl 11.0

// I/O, strings, memory allocation
#include "support.h"

// Global modules
#include "locale.h"
#include "limits.h"
#include "options.h"
#include "tokens.h"
#include "trees.h"
#include "errors.h"
#include "shared.h"
#include "charset.h"
#include "idents.h"

// Compiler modules
#include "rules.h"

#ifdef PROFILER
    #include "symbols.h"
#endif

// Check interface consistency
#include "parse.h"

// Current input token
static tokenT parser_nextToken;
static tokenT parser_nextRawToken;
static enum treeKindT  parser_nextTokenKind;

// Parse stack for detecting infinite parses -
// these days we use it only for choices (choose, leftchoose)
static int parser_parseDepth;  // 0

// parseStack [0 .. parseDepth] are the names of the choices we are currently parsing
static array (tokenT, parser_parseStack);

// parseTokenIndex [0 .. parseDepth] are the handles of the last token accepted by each choice
// parseTokenIndex (d) = K means the choice accepted the token with handle K
// parseTokenIndex (d) = 0 means we don't know for sure whether the choice has accepted any tokens
static array (tokenIndexT, parser_parseTokenIndex);

// If we give up at the same point twice, we are likely in permanent trouble.
// So we keep track, and give up permanently the second time.
static int parser_maxRecursionTokenIndex;  // -1

// Is this TXL we are parsing?
static bool parser_txlParse;  // false

// Is this a pattern we are parsing?
static bool parser_patternParse;  // false

// Local symbol table of rule for pattern parse
static struct ruleLocalsT *parser_patternVarsAddr;

// Description of our current parsing context, for error messages
static string parser_parseContext;  // ""

// Procedure to parse TXL variable bindings and references in patterns and replacements
// (provided by comprul.i)
static parser_parseVarOrExpProc *parser_parsePatternVarOrExp;

// Implementation of backtrack fences [!]
static bool parser_fenceState;  // false

// Hard limit to prevent infinite parses
static int parser_parseCycles;  // 0

// Implementation of [push] / [pop] matching
static tokenT *parser_matchStack;  // [0 .. maxParseDepth]
static int parser_matchTop;  // 0

static void parser_matchPush (const tokenT token)
{
    assert (parser_matchTop < maxParseDepth);
    parser_matchTop += 1;
    parser_matchStack[parser_matchTop] = token;
}

static void parser_matchPop (void) {
    assert (parser_matchTop > 0);
    parser_matchTop -= 1;
}

static tokenT parser_matchToken (void) {
    if (parser_matchTop > 0) {
        return (parser_matchStack[parser_matchTop]);
    } else {
        return (NOT_FOUND);
    }
}

#ifdef PROFILER

// We only want to profile the main parse
static bool parser_mainParse = false;

// Cycle counts 
static int parser_backtrackCycles;

// Nonterminal symbol stats 
struct parser_symbolStatisticsT {
    int calls;
    int matches;
    int parsecycles;
    int backtrackcycles;
    int trees;
    int kids;
};
    
// 1-origin [1 .. maxSymbols]
static array (struct parser_symbolStatisticsT, parser_symbolStatistics);

// 1-origin [1 .. maxParseDepth]
static array (struct parser_symbolStatisticsT, parser_oldStatistics);
static array (struct parser_symbolStatisticsT, parser_startStatistics);

#endif

void parser_initializeParse (const string context, const bool isMain, const bool isPattern, const bool isTxl, 
        struct ruleLocalsT *localVarsAddr, parser_parseVarOrExpProc *parseVarOrExp)
{
    assert ((!isPattern) || ((localVarsAddr != (struct ruleLocalsT *) 0) && (parseVarOrExp != (parser_parseVarOrExpProc *) 0)));

    // Tokens to be parsed are in inputTokens array - begin at the beginning
    currentTokenIndex = 1;
    parser_nextToken = inputTokens[currentTokenIndex].token;
    parser_nextRawToken = inputTokens[currentTokenIndex].rawtoken;
    parser_nextTokenKind = inputTokens[currentTokenIndex].kind;
    failTokenIndex = 1;

    // Initialize the parse stack
    parser_parseDepth = 0;
    parser_parseStack[parser_parseDepth] = undefined_T;
    parser_parseTokenIndex[parser_parseDepth] = 1;
    parser_maxRecursionTokenIndex = -1;

    // What are we parsing?
    stringcpy (parser_parseContext, context);
    parser_patternParse = isPattern;
    parser_txlParse = isTxl;

    // If we're parsing a pattern or replacement, 
    // we need the local variables and local variable reference parser from the rule compiler
    parser_patternVarsAddr = localVarsAddr;
    parser_parsePatternVarOrExp = parseVarOrExp;

    // Keep track of parse limit
    parser_parseCycles = 0;
#ifdef PROFILER
    parser_backtrackCycles = 0;
    parser_mainParse = isMain;
#endif
}

static void parser_accept (void) {
    assert (currentTokenIndex < lastTokenIndex);
    currentTokenIndex += 1;
    if (currentTokenIndex > failTokenIndex) {
        failTokenIndex = currentTokenIndex;
    }
    parser_nextToken = inputTokens[currentTokenIndex].token;
    parser_nextRawToken = inputTokens[currentTokenIndex].rawtoken;
    parser_nextTokenKind = inputTokens[currentTokenIndex].kind;
}

static void parser_backup (void) {
    assert (currentTokenIndex > 1);
    currentTokenIndex -= 1;
    parser_nextToken = inputTokens[currentTokenIndex].token;
    parser_nextRawToken = inputTokens[currentTokenIndex].rawtoken;
    parser_nextTokenKind = inputTokens[currentTokenIndex].kind;
}

static void parser_backup_tree (const treePT subtreeTP)
{
    switch (tree_trees[subtreeTP].kind) {
        case treeKind_choose:
            {
                // optimize by skipping choose chains 
                treePT chainTP = tree_kids[tree_trees[subtreeTP].kidsKP];
                while (true) {
                    if ((tree_trees[chainTP].kind) != 1) break;
                    chainTP = tree_kids[tree_trees[chainTP].kidsKP];
                }
                parser_backup_tree (chainTP);
            }
            break;

        case treeKind_order:
            {
                kidPT subtreeKidsKP = tree_trees[subtreeTP].kidsKP;
                for (int i = 1; i <= tree_trees[subtreeTP].count; i++) {
                    parser_backup_tree (tree_kids[subtreeKidsKP]);
                    subtreeKidsKP += 1;
                }
            }
            break;

        case treeKind_repeat:
            {
                kidPT subtreeKidsKP = tree_trees[subtreeTP].kidsKP;
                while (true) {
                    parser_backup_tree (tree_kids[subtreeKidsKP]);
                    if ((tree_trees[tree_kids[subtreeKidsKP + 1]].kind >= firstSpecialKind) 
                            || (tree_trees[tree_kids[subtreeKidsKP + 1]].kind == treeKind_empty))
                        break;
                    subtreeKidsKP = tree_trees[tree_kids[subtreeKidsKP + 1]].kidsKP;
                }
            }
            break;

        case treeKind_list:
            {
                kidPT subtreeKidsKP = tree_trees[subtreeTP].kidsKP;
                while (true) {
                    parser_backup_tree (tree_kids[subtreeKidsKP]);
                    if (((tree_trees[tree_kids[subtreeKidsKP + 1]].kind >= firstSpecialKind) 
                            || (tree_trees[tree_kids[subtreeKidsKP + 1]].kind == treeKind_empty)) 
                        || ((tree_trees[tree_kids[subtreeKidsKP + 1]].kind == treeKind_list) 
                            && (tree_trees[tree_kids[(tree_trees[tree_kids[subtreeKidsKP + 1]].kidsKP) + 1]].kind == treeKind_empty))) 
                        break;
                    parser_backup ();  // the separator nonterminal
                    subtreeKidsKP = tree_trees[tree_kids[subtreeKidsKP + 1]].kidsKP;
                }
            }
            break;

        case treeKind_empty:
            break;

        case treeKind_srclinenumber: case treeKind_srcfilename:
            break;

        case treeKind_literal: case treeKind_stringlit: case treeKind_charlit: case treeKind_token:
        case treeKind_id: case treeKind_upperlowerid: case treeKind_upperid: case treeKind_lowerupperid: case treeKind_lowerid:
        case treeKind_number: case treeKind_floatnumber: case treeKind_decimalnumber: case treeKind_integernumber:
        case treeKind_key: case treeKind_comment: case treeKind_space: case treeKind_newline:
        case treeKind_usertoken1: case treeKind_usertoken2: case treeKind_usertoken3: case treeKind_usertoken4: case treeKind_usertoken5:
        case treeKind_usertoken6: case treeKind_usertoken7: case treeKind_usertoken8: case treeKind_usertoken9: case treeKind_usertoken10:
        case treeKind_usertoken11: case treeKind_usertoken12: case treeKind_usertoken13: case treeKind_usertoken14: case treeKind_usertoken15:
        case treeKind_usertoken16: case treeKind_usertoken17: case treeKind_usertoken18: case treeKind_usertoken19: case treeKind_usertoken20:
        case treeKind_usertoken21: case treeKind_usertoken22: case treeKind_usertoken23: case treeKind_usertoken24: case treeKind_usertoken25:
        case treeKind_usertoken26: case treeKind_usertoken27: case treeKind_usertoken28: case treeKind_usertoken29: case treeKind_usertoken30:
            {
                // its' a terminal, back up over it
                parser_backup ();
            }
            break;

        case treeKind_firstTime: case treeKind_subsequentUse: case treeKind_expression: case treeKind_lastExpression :
            {
                // pattern variable - back up over it
                parser_backup ();
                #ifndef NOCOMPILE
                    if ((tree_trees[subtreeTP].kind) == treeKind_firstTime) {
                        // if we back up over a binding occurrence, undo its binding
                        rule_unenterLocalVar (parser_parseContext, parser_patternVarsAddr, tree_trees[subtreeTP].name);
                    }
                #endif
            }
            break;

        default :
            {
                error ("", "Fatal TXL error in backup_tree", INTERNAL_FATAL, 121);
            }
            break;
    }
}

static bool parser_is_empty (const treePT subtreeTP)
{
    switch (tree_trees[subtreeTP].kind) {
        case treeKind_choose:
            {
                // optimize by skipping choose chains
                kidPT chainTP = tree_kids[tree_trees[subtreeTP].kidsKP];
                while (true) {
                    if (tree_trees[chainTP].kind != treeKind_choose) break;
                    chainTP = tree_kids[tree_trees[chainTP].kidsKP];
                }
                return (parser_is_empty (chainTP));
            }
            break;

        case treeKind_order:
            {
                kidPT subtreeKidsKP = tree_trees[subtreeTP].kidsKP;
                for (int i = 1; i <= tree_trees[subtreeTP].count; i++) {
                    if (!parser_is_empty (tree_kids[subtreeKidsKP])) {
                        return (false);
                    }
                    subtreeKidsKP += 1;
                }
                return (true);
            }
            break;

        case treeKind_repeat:
            {
                kidPT subtreeKidsKP = tree_trees[subtreeTP].kidsKP;
                while (true) {
                    if (!parser_is_empty (tree_kids[subtreeKidsKP])) {
                        return (false);
                    }
                    if (tree_trees[tree_kids[subtreeKidsKP + 1]].kind == treeKind_empty) break;
                    subtreeKidsKP = tree_trees[tree_kids[subtreeKidsKP + 1]].kidsKP;
                }
                return (true);
            }
            break;

        case treeKind_list:
            {
                kidPT subtreeKidsKP = tree_trees[subtreeTP].kidsKP;
                if (!parser_is_empty (tree_kids[subtreeKidsKP])) {
                    return (false);
                }
                return (tree_trees[tree_kids[subtreeKidsKP + 1]].kind == treeKind_empty);
            }
            break;

        case treeKind_empty:
            {
                return (true);
            }
            break;

        case treeKind_srclinenumber: case treeKind_srcfilename:
            {
                return (true);
            }
            break;

        case treeKind_literal: case treeKind_stringlit: case treeKind_charlit: case treeKind_token:
        case treeKind_id: case treeKind_upperlowerid: case treeKind_upperid: case treeKind_lowerupperid: case treeKind_lowerid:
        case treeKind_number: case treeKind_floatnumber: case treeKind_decimalnumber: case treeKind_integernumber:
        case treeKind_key: case treeKind_comment: case treeKind_space: case treeKind_newline:
        case treeKind_usertoken1: case treeKind_usertoken2: case treeKind_usertoken3: case treeKind_usertoken4: case treeKind_usertoken5:
        case treeKind_usertoken6: case treeKind_usertoken7: case treeKind_usertoken8: case treeKind_usertoken9: case treeKind_usertoken10:
        case treeKind_usertoken11: case treeKind_usertoken12: case treeKind_usertoken13: case treeKind_usertoken14: case treeKind_usertoken15:
        case treeKind_usertoken16: case treeKind_usertoken17: case treeKind_usertoken18: case treeKind_usertoken19: case treeKind_usertoken20:
        case treeKind_usertoken21: case treeKind_usertoken22: case treeKind_usertoken23: case treeKind_usertoken24: case treeKind_usertoken25:
        case treeKind_usertoken26: case treeKind_usertoken27: case treeKind_usertoken28: case treeKind_usertoken29: case treeKind_usertoken30:
            {
                return (false);
            }
            break;

        case treeKind_firstTime: case treeKind_subsequentUse: case treeKind_expression: case treeKind_lastExpression :
            {
                return (false);
            }
            break;

        default :
            {
                error ("", "Fatal TXL error in is_empty", INTERNAL_FATAL, 122);
                return (false);
            }
            break;
    }
}

static int parser_depthOfLastAccept (void) {
    {
        for (int d = parser_parseDepth; d >= 0; d--) {
            if ((parser_parseTokenIndex[d] < currentTokenIndex) && (parser_parseTokenIndex[d] != 0)) {
                return (d);
            }
        }
    }
    return (0);
}

#ifndef STANDALONE
static void parser_trace_enter (const treePT productionTP, const bool retry)
{
    string dots;
    stringrep (dots, ".", parser_parseDepth);
    fprintf (stderr, "%s?%s", dots, *ident_idents[tree_trees[productionTP].rawname]);
    if (retry) {
        fprintf (stderr, "%s", " <-* ->  ");
    }
    if (parser_nextToken == empty_T) {
        fprintf (stderr, "%s", " EOF\n");
    } else {
        fprintf (stderr, " %s\n", *ident_idents[parser_nextToken]);
    }
}

static void parser_trace_exit (const treePT productionTP, const treePT parseTP)
{
    if (parseTP == nilTree) {
        string dots;
        stringrep (dots, ".", parser_parseDepth);
        fprintf (stderr, "%s#%s", dots, *ident_idents[tree_trees[productionTP].rawname]);
        if (parser_nextToken == empty_T) {
            fprintf (stderr, "%s\n", " EOF");
        } else {
            fprintf (stderr, " %s\n", *ident_idents[parser_nextToken]);
        }
    } else {
        string dots;
        stringrep (dots, ".", parser_parseDepth);
        fprintf (stderr, "%s!%s\n", dots, *ident_idents[tree_trees[productionTP].rawname]);
    }
}
#endif

static void parser_dumpparsestack (void) {
    fprintf (stderr, "%s\n", "=== Parse Stack Dump ===");
    {
        for (int i = parser_parseDepth; i >= 0; i--) {
            fprintf (stderr, "%s %d", *ident_idents[parser_parseStack[i]], parser_parseTokenIndex[i]);
            if (parser_parseTokenIndex[i] != 0) {
                fprintf (stderr, " %s", *ident_idents[inputTokens[parser_parseTokenIndex[i]].token]);
            }
            fprintf (stderr, "\n");
        }
    }
    fprintf (stderr, "%s\n", "=== ===");
}

static treePT parser_lastEmptyWarningTP;  // nilTree

static void parser_recursion_error (const treePT productionTP)
{
    if (productionTP != parser_lastEmptyWarningTP) {
        string context, message;
        stringprintf (context, "define '%s'", *ident_idents[tree_trees[productionTP].name]);
        stringprintf (message, "Empty recursion could not be resolved with lookahead '%s' after %d recursions (using pruning heuristic to recover)", 
            *ident_idents[parser_nextRawToken], maxLeftRecursion);
        error (context, message, WARNING, 123);
        if (options_option[stack_print_p]) {
            parser_dumpparsestack ();
        }
        parser_lastEmptyWarningTP = productionTP;
    }
}

static void parser_maxdepth_error (void) {
    error (parser_parseContext, "Maximum parse depth exceeded", DEFERRED, 126);
    if (options_option[stack_print_p]) {
        parser_dumpparsestack ();
    }
}

static void parser_cyclelimit_error (void) {
    {
        string message;
        stringprintf (message, "Parse time limit (%d cycles) exceeded", maxParseCycles);
        error (parser_parseContext, message, DEFERRED, 127);
    }
    if (options_option[stack_print_p]) {
        parser_dumpparsestack ();
    }
}

static void parser_fatal_error (const int which)
{
    {
        string message;
        stringprintf (message, "Fatal TXL error %d in parse", which);
        error (parser_parseContext, message, INTERNAL_FATAL, 128);
    }
    if (options_option[stack_print_p]) {
        parser_dumpparsestack ();
    }
}

static void parser_real_parse (const treePT productionTP, treePT *parseTP);

static void parser_parse_extend (const treePT productionTP, treePT *parseTP)
{
    // Bottom-up extension of an existing parse of a left recursive production
    assert (tree_trees[productionTP].kind == treeKind_order);

    const int productionKids = tree_trees[productionTP].count;
    assert (productionKids > 0);

    // Recover wasted space if we fail
    const int oldKidCount = tree_kidCount;
    const int oldTreeCount = tree_treeCount;

    // Since they are contiguous, we can just run up and down
    // the production kid lists directly!
    const kidPT baseProductionKidsKP = (tree_trees[productionTP].kidsKP) - 1;

    // Pre-allocate a chunk of the kids array and use it directly 
    // to fill in kids while trying to find a parse.
    // Link it up later to the new parse tree if we succeed, otherwise free it.
    // If we allocate the kids of the parse contiguously, 
    // we can use them in place too!
    kidPT parseKidsKP = tree_newKids (productionKids);
    const kidPT baseParseKidsKP = parseKidsKP - 1;

    // Now we parse!
    // If we are trying to optimize a recursion, then we will use the previous
    // parse as kid 1 and start at kid 2.
    
    // Link in our previous parse
    tree_setKidTree (baseParseKidsKP + 1, *parseTP);
    tree_setKidTree (baseParseKidsKP + 2, nilTree);
    // Start with it
    int kid = 2;
    // And with a null parse tree
    *parseTP = nilTree;

    // Let's go!
    bool retry = false;
    while (true) {
        const tokenIndexT oldTokenIndex = currentTokenIndex;

        treePT kidTP = tree_kids[baseParseKidsKP + kid];
        parser_real_parse (tree_kids[baseProductionKidsKP + kid], &kidTP);
        tree_setKidTree (baseParseKidsKP + kid, kidTP);

        if (tree_kids[baseParseKidsKP + kid] == nilTree) {
            // Retry another match of the previous kid,
            // but don't back up over the original parse we are extending
            kid -= 1;
            if (kid < 2) break;
            retry = true;

        } else if ((!retry) || (currentTokenIndex != oldTokenIndex)) {
            // Go on to the next one
            kid += 1;
            if (kid > productionKids) break;
            retry = false;
            tree_setKidTree (baseParseKidsKP + kid, nilTree);  // first try

        // else
            // Re-parses of an embedded kid that yield the
            // same lookahead are uninteresting since the
            // rest will fail in the same way!
            //  - so just ask for another try of the same kid
        }
    }

    // We succeed if we made it all the way to the right.
    if (kid > productionKids) {
        // Successful extension of existing parse
        // Build the parent
        *parseTP = tree_newTreeClone (productionTP);
        // Link in the kids we already sneakily allocated
        // and filled in directly back there
        tree_setKids (*parseTP, parseKidsKP);
    } else {
        // Failed to extend the parse
        *parseTP = nilTree;
        // Recover wasted space
        if (tree_allocationStrategy == simple) {
            tree_setTreeCount (oldTreeCount);
            tree_setKidCount (oldKidCount);
        }
    }
}

// Utility routines to avoid causing string temporaries in the highly recursive real_parse

static void parser_installNumber (const int number, const enum treeKindT kind, tokenT *name)
{
    string numbertext;
    stringprintf (numbertext, "%d", number);
    *name = ident_install (numbertext, kind);
}

static void parser_installAsId (const tokenT stringname, tokenT *idname)
{
    string idtext;
    substring (idtext, *ident_idents[stringname], 2, lstringlen (*ident_idents[stringname] - 1));
    *idname = ident_install (idtext, treeKind_id);
}

static void parser_real_parse (const treePT productionTP, treePT *parseTP)
{
    // INPUT:
    //    productionTP -        the target production
    //    parseTP -     either  1) nil, or
    //                  2) a previous parse yeilding the target
    // OUTPUT:
    //    parseTP -     either  1) a parse yeilding the target production, or
    //                  2) nil
    //
    // If input parseTP is nil, then output parseTP is the first possible parse.
    // If input parseTP is a previous parse, the output parseTP is the next possible parse.
    // In either case, if the parse is not possible then output parseTP will be nil.

    // **************************************************************************
    // NOTE: Since this routine is very highly recursive, it is desirable
    // to minimize the amount of local storage in order to avoid stack exhaustion.
    // In particular, string operations should not be done in this routine since 
    // they make local string temporaries that eat stack space. 
    // For this reason all multi-use local variables have been gathered here.
    // **************************************************************************

    // Stack use limitation - to avoid crashes
    checkstack ();

    // Keep all multi-use vars and consts here - to keep track of local space
    treePT parseKidTP;
    kidPT parseKidsKP;
    kidPT productionKidsKP;
    kidPT baseProductionKidsKP;
    kidPT baseParseKidsKP;
    int oldKidCount;
    int oldTreeCount;
    int productionKids;
    int kidLastTime;
    int oldMatchTop;
    tokenIndexT oldTokenIndex;
#ifndef NOCOMPILE
    bool isVarOrExp = false;
    bool varOrExpMatches = false;
#endif
    bool retry;
    const enum treeKindT productionKind = tree_trees[productionTP].kind;

    // Keep track of number of parse cycles
    parser_parseCycles += 1;
    if (parser_parseCycles > maxParseCycles) {
        parser_cyclelimit_error ();
        throw (CYCLELIMIT);
    }

#ifndef NOCOMPILE
    if (options_option[tree_print_p]) {
        parser_trace_enter (productionTP, (*parseTP != nilTree));
    }

    if (parser_patternParse) {
        // We're parsing a TXL pattern or replacement

        // See if we're backing up over a variable
        if ((*parseTP != nilTree) 
                && ((tree_trees[*parseTP].kind == treeKind_expression) || (tree_trees[*parseTP].kind == treeKind_firstTime) 
                    || (tree_trees[*parseTP].kind == treeKind_subsequentUse))) {

            // Heuristic check for infinite parse of variable
            if (parser_parseDepth > (lastTokenIndex * 2)) {
                // We've failed to find a parse even after extending
                // twice as deep as we ought to have to - so backup 
                // and declare failure.

                parser_backup ();

                #ifndef NOCOMPILE
                    // If it was a binding occurence, undo the binding
                    if (tree_trees[*parseTP].kind == treeKind_firstTime) {
                        rule_unenterLocalVar (parser_parseContext, parser_patternVarsAddr, tree_trees[*parseTP].name);
                    }
                #endif

                // Now fail
                *parseTP = nilTree;

                #ifndef NOCOMPILE
                if (options_option[tree_print_p]) {
                    parser_trace_exit (productionTP, *parseTP);
                }
                #endif

                return;
            }

            // Retrying a variable match -
            //   what we do is look for a deeper match first, before coming back up.
            // We can do that by fooling the parse algorithm into believing
            // that we are trying the first match of a variable that doesn't match
            // at this level.

            // Note that we don't want to do this if the variable is matched
            // to a leftchoose, since in that case we try embedding it directly.
            if (productionKind == treeKind_leftchoose) {
                // So simply pass it on to the regular backtrack strategy.
                isVarOrExp = true;
                varOrExpMatches = true;

            } else {
                // In all other cases we follow the old strategy
                parser_backup ();

                #ifndef NOCOMPILE
                    // If the variable we are backing up over was a binding occurence,
                    // undo the binding
                    if (tree_trees[*parseTP].kind == treeKind_firstTime) {
                        rule_unenterLocalVar (parser_parseContext, parser_patternVarsAddr, tree_trees[*parseTP].name);
                    }
                #endif

                *parseTP = nilTree;
                isVarOrExp = true;
                varOrExpMatches = false;
            }
        }

        // If this is the first try, see if we have a TXL variable
        if (*parseTP == nilTree) {
            // If we don't know yet, see if we are dealing with a TXL variable
            if ((!isVarOrExp) && ((parser_nextTokenKind == treeKind_id) || (parser_nextTokenKind == treeKind_key))) {
                // Could be a TXL variable
                const int oldnlocals = parser_patternVarsAddr -> nlocals;

                (*parser_parsePatternVarOrExp) (inputTokens[currentTokenIndex].tree, parser_patternVarsAddr, 
                    productionTP, parseTP, &isVarOrExp, &varOrExpMatches);

                // If it's not going to match, then don't bind it now
                if (isVarOrExp && (!varOrExpMatches)) {
                    parser_patternVarsAddr -> nlocals = oldnlocals;
                }
            }

            if (isVarOrExp) {
                // A TXL variable ...
                if (varOrExpMatches) {
                    // ... that matches the production exactly
                    parser_accept ();

                    #ifndef NOCOMPILE
                    if (options_option[tree_print_p]) {
                        parser_trace_exit (productionTP, *parseTP);
                    }
                    #endif

                    return;

                } else if (productionKind >= firstLiteralKind) {
                    // ... that does not match a terminal - nothing to do but fail
                    *parseTP = nilTree;

                    #ifndef NOCOMPILE
                    if (options_option[tree_print_p]) {
                        parser_trace_exit (productionTP, *parseTP);
                    }
                    #endif

                    return;
                }
            }

            // At this point, either it is not a TXL variable, 
            // or it is a TXL variable that does not match an empty, order, or choose,
            // in which case we must look further for a match to it.
            assert ((!isVarOrExp) || (!varOrExpMatches));
        }
    }
    #endif

    // Statistical profile of production kinds in typical large Legasys run
        
    // kind                first try              retry             combined
    // ----                ---------              -----             --------
    // literal          1643250   33.0%      102011    6.6%     1745261   26.8%
    // empty            1350270   27.2%     1216506   78.4%     2566776   39.3%
    // order            1115541   22.4%       30119    1.9%     1145660   17.6%
    // choose            504255   10.1%      132162    8.5%      636417    9.8%
    // generaterepeat    156275    3.1%       41153    2.7%      197428    3.0%
    // id                132517    2.7%       15609    1.0%      148126    2.3%
    // repeat             27520    0.6%       13754    0.9%       41274    0.6%
    // stringlit          17953    0.4%           0      0%       17953    0.3%
    // charlit            15996    0.3%           0      0%       15996    0.2%
    // number              8614    0.2%          77      0%        8691    0.1%
    // leftchoose             0      0%           0      0%           0      0%
    // generatelist           0      0%           0      0%           0      0%
    // list                   0      0%           0      0%           0      0%
    // all others             0      0%           0      0%           0      0%

    // Shortcut for most common cases
    if (productionKind == treeKind_empty) {
        if (*parseTP == nilTree) {
            // empty - first time we just match it
            *parseTP = productionTP;

            #ifndef NOCOMPILE
            if (options_option[tree_print_p]) {
                parser_trace_exit (productionTP, *parseTP);
            }
            #endif 

            return;

        } else {
            // Backtracking over a match of empty!!
            // If this is a keeper, we can't back it up.
            if (tree_trees[*parseTP].name == KEEP_T) {
                throw (CUTPOINT);
            }

            // If this is a fence [!], then we have failed this sequence
            if (tree_trees[*parseTP].name == FENCE_T) {
                parser_fenceState = true;
            }

            *parseTP = nilTree;

            #ifndef NOCOMPILE
            if (options_option[tree_print_p]) {
                parser_trace_exit (productionTP, *parseTP);
            }
            #endif

            return;
        }

    } else if (productionKind == treeKind_literal) {
        if (*parseTP == nilTree) {
            // Don't care what it is, but it must match exactly
            if ((parser_nextTokenKind != treeKind_comment) 
                    && (parser_nextTokenKind != treeKind_empty) && (parser_nextToken == tree_trees[productionTP].name)) {
                // accept
                if (parser_nextRawToken == parser_nextToken) {
                    *parseTP = productionTP;
                } else {
                    *parseTP = tree_newTreeClone (productionTP);
                    tree_setRawName (*parseTP, parser_nextRawToken);
                }
                parser_accept ();
            }

            #ifndef NOCOMPILE
            if (options_option[tree_print_p]) {
                parser_trace_exit (productionTP, *parseTP);
            }
            #endif

            return;

        } else {
            // Retrying a terminal - only thing left to do is back up!
            assert (currentTokenIndex > 0);
            assert (tree_trees[*parseTP].name == inputTokens[currentTokenIndex - 1].token);

            *parseTP = nilTree;
            parser_backup ();

            #ifndef NOCOMPILE
            if (options_option[tree_print_p]) {
                parser_trace_exit (productionTP, *parseTP);
            }
            #endif

            return;
        }
    }

    #ifdef PROFILER 
    // Keep track of nonterminal symbol statistics
    struct parser_symbolStatisticsT *oldStats = &(parser_oldStatistics[parser_parseDepth]);
    struct parser_symbolStatisticsT *startStats = &(parser_startStatistics[parser_parseDepth]);

    if (parser_mainParse && (tree_trees[productionTP].kind < treeKind_empty)) {
        const int symbolIndex = symbol_findSymbol (tree_trees[productionTP].name);
        const struct parser_symbolStatisticsT *symbolStats = &(parser_symbolStatistics[symbolIndex]);
        oldStats -> parsecycles = symbolStats -> parsecycles;
        oldStats -> backtrackcycles = symbolStats -> backtrackcycles;
        oldStats -> trees = symbolStats -> trees;
        oldStats -> kids = symbolStats -> kids;
        startStats -> parsecycles = parser_parseCycles;
        startStats -> backtrackcycles = parser_backtrackCycles;
        startStats -> trees = tree_treeCount;
        startStats -> kids = tree_kidCount;
    }
    #endif

    if (*parseTP == nilTree) {

        switch (productionKind) {

            case treeKind_empty:
                {
                    // empty - first time we just match it
                    *parseTP = productionTP;
                }
                break;

            case treeKind_order:
                {
                    // Parse an order node
                    productionKids = tree_trees[productionTP].count;
                    assert (productionKids > 0);

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Since they are contiguous, we can just run up and down
                    // the production kid lists directly!
                    baseProductionKidsKP = tree_trees[productionTP].kidsKP - 1;

                    // Pre-allocate a chunk of the kids array and use it directly 
                    // to fill in kids while trying to find a parse.
                    // Link it up later to the new parse tree if we succeed, otherwise free it.
                    parseKidsKP = tree_newKids (productionKids);
                    baseParseKidsKP = parseKidsKP - 1;

                    // Now we parse!

                    // If se are trying for the first time, we start with kid 1
                    retry = false;
                    int kid = 1;
                    tree_setKidTree (baseParseKidsKP + 1, nilTree);

                    // Let's go!
                    while (true) {
                        oldTokenIndex = currentTokenIndex;

                        treePT kidTP = tree_kids[baseParseKidsKP + kid];
                        parser_real_parse (tree_kids[baseProductionKidsKP + kid], &kidTP);
                        tree_setKidTree (baseParseKidsKP + kid, kidTP);

                        if (tree_kids[baseParseKidsKP + kid] == nilTree) {
                            // Retry another match of the previous kid
                            kid -= 1;
                            if (kid < 1) break;
                            retry = true;

                            // If we backtracked into a fence, we've failed the sequence
                            if (parser_fenceState) break;

                        } else if ((!retry) || (currentTokenIndex != oldTokenIndex)) {
                            // Go on to the next one
                            kid += 1;
                            if (kid > productionKids) break;
                            retry = false;
                            tree_setKidTree (baseParseKidsKP + kid, nilTree);   // first try

                        // } else {
                            // Re-parses of an embedded kid that yield the
                            // same lookahead are uninteresting since the
                            // rest will fail in the same way!
                            //  - so just ask for another try of the same kid
                        }
                    }

                    // We fail if we're at the left, succeed if we made it all the way to the right
                    if (kid > 0) {
                        if (!parser_fenceState) {
                            // Build the parent
                            *parseTP = tree_newTreeClone (productionTP);  // sets kind, name and nKids
                            // Link in the kids we already sneakily allocated
                            // and filled in directly back there
                            tree_setKids (*parseTP, parseKidsKP);
                        } else {
                            // Hit a fence - we must undo the partial parse and fail
                            while (true) {
                                if (kid == 0) break;
                                parser_backup_tree (tree_kids[baseParseKidsKP + kid]);
                                kid -= 1;
                            }
                            // Failed to get a parse
                            *parseTP = nilTree;
                            // Recover wasted space
                            if (tree_allocationStrategy == simple) {
                                tree_setTreeCount (oldTreeCount);
                                tree_setKidCount (oldKidCount);
                            }
                        }

                    } else {
                        // Failed to get a parse
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }

                    // Reset the fence flag
                    parser_fenceState = 0;
                }
                break;


            case treeKind_choose:

                {
                    // Parse a choose node

                    // Check for infinite parse loop
                    if ((parser_parseDepth - parser_depthOfLastAccept ()) > maxBlindParseDepth) {
                        int nrepeats = 1;
                        for (int pd = parser_parseDepth; pd >= (parser_depthOfLastAccept () + 1); pd--) {
                            if ((parser_parseStack[pd]) == (tree_trees[productionTP].name)) {
                                nrepeats += 1;
                            }
                        }

                        if (nrepeats > maxLeftRecursion) {
                            // the never-ending story 
                            if ((nrepeats > (maxLeftRecursion + 1)) && (parser_maxRecursionTokenIndex == currentTokenIndex)) {
                                // we've already given them one chance 
                                throw (PARSETOODEEP);
                            }

                            if (options_option[verbose_p]) {
                                parser_recursion_error (productionTP);
                            }

                            // remember where we caught it
                            parser_maxRecursionTokenIndex = currentTokenIndex;

                            *parseTP = nilTree;

                            #ifndef NOCOMPILE
                            if (options_option[tree_print_p]) {
                                parser_trace_exit (productionTP, *parseTP);
                            }
                            #endif

                            return;
                        }
                    }

                    // Check for unsolvable TXL 10.1 parse ambiguity - this is a serious cheat, and I'll never admit to it!
                    if (parser_txlParse && (parser_nextToken == dotDotDot_T) && (tree_trees[productionTP].name == TXL_optBar_T) 
                            && (currentTokenIndex > 0) && (inputTokens[currentTokenIndex - 1].token == bar_T)) {
                        *parseTP = nilTree;
                        return;
                    }

                    // Update parse stack
                    if (parser_parseDepth == maxParseDepth) {
                        parser_maxdepth_error ();
                        throw (PARSETOODEEP);
                    }

                    parser_parseDepth += 1;
                    parser_parseStack[parser_parseDepth] = tree_trees[productionTP].name;
                    parser_parseTokenIndex[parser_parseDepth] = currentTokenIndex;

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Total number of choices we have
                    productionKids = tree_trees[productionTP].count;

                    // Since production kids are allocated contiguously,
                    // we can walk through them directly in the kids array.
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We begin with the first choice
                    parseKidTP = nilTree;

                    // Try each alternative until we get a match
                    for (int kid = 1; kid <= productionKids; kid++) {
                        parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);
                        if (parseKidTP != nilTree) {
                            // Allocate the new parse tree and kid
                            *parseTP = tree_newTreeClone (productionTP);
                            tree_setKind (*parseTP, treeKind_choose);
                            // Link in the new kid we managed to parse
                            tree_makeOneKid (*parseTP, parseKidTP);
                            // Encode the choice we made in the parse tree, in case we need to retry
                            tree_setCount (*parseTP, kid);
                            break;
                        }
        
                        // Try the next alternative
                        productionKidsKP += 1;
                    }

                    if (parseKidTP == nilTree) {
                        // We failed to find a matching alternative
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }
                    parser_parseDepth -= 1;
                }
                break;

            case treeKind_generaterepeat:
                {
                    // New style generate [repeat] node
                    // (No need to check for infinite parse loop on repeats)
                    // (Empty repeated items handled automatically now)

                    // update parse stack (for choose/generate nodes only!)
                    parser_parseDepth += 1;
                    parser_parseStack[parser_parseDepth] = tree_trees[productionTP].name;
                    parser_parseTokenIndex[parser_parseDepth] = currentTokenIndex;
        
                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We begin with the first choice.
                    // If it fails, then we take the second (empty) choice.
                    // One or the other always succeeds.

                    // Allocate new parse tree and kids
                    parseKidsKP = tree_newKids (2);
                    *parseTP = tree_newTreeInit (treeKind_repeat, tree_trees[productionTP].name, tree_trees[productionTP].rawname, 2, parseKidsKP);

                    // Recover wasted space if we end up with the empty case
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // No empty items are allowed
                    oldTokenIndex = currentTokenIndex;

                    // Look for a parse of an item
                    while (true) {
                        treePT kidTP = tree_kids[parseKidsKP];
                        parser_real_parse (tree_kids[productionKidsKP], &kidTP);
                        tree_setKidTree (parseKidsKP, kidTP);
                        if ((tree_kids[parseKidsKP] == nilTree) || (currentTokenIndex != oldTokenIndex)) 
                            break;
                    }

                    if (tree_kids[parseKidsKP] != nilTree) {
                        // Got one - now parse a tail for it
                        treePT kidTP = tree_kids[parseKidsKP + 1];
                        parser_real_parse (productionTP, &kidTP);
                        tree_setKidTree ((parseKidsKP + 1), kidTP);
                    } else {
                        // We failed to get a parse - but the empty case always succeeds
                        #ifndef NOCOMPILE
                        if (parser_patternParse) {
                            int kidTP;
                            tree_setKidTree (parseKidsKP, emptyTP);
                            kidTP = tree_kids[parseKidsKP + 1];
                            parser_real_parse (emptyTP, &kidTP);
                            tree_setKidTree (parseKidsKP + 1, kidTP);
                            assert (tree_kids[parseKidsKP + 1] != nilTree);
                        } else {
                            tree_setKidTree (parseKidsKP, emptyTP);
                            tree_setKidTree (parseKidsKP + 1, emptyTP);
                        }
                        #else
                        tree_setKidTree (parseKidsKP, emptyTP);
                        tree_setKidTree (parseKidsKP + 1, emptyTP);
                        #endif

                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }

                    parser_parseDepth -= 1;
                }
                break;

            case treeKind_repeat:
                {
                    // New style [repeat+] node
                    // (No need to check for infinite parse loop on repeats)
                    // (Empty repeated items handled automatically now)
                    // (Parse stack gets updated for choose nodes only!)

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We must have an item, otherwise [repeat+] fails

                    // Allocate new parse tree and kids
                    // Name and kind of the parsed node must be the same as for any other repeat!
                    parseKidsKP = tree_newKids (2);
                    *parseTP = tree_newTreeInit (treeKind_repeat, tree_trees[tree_kids[productionKidsKP + 1]].name, 
                        tree_trees[tree_kids[productionKidsKP + 1]].rawname, 2, parseKidsKP);

                    // No empty items allowed ...
                    oldTokenIndex = currentTokenIndex;

                    // Look for a parse of an item
                    while (true) {
                        treePT kidTP = tree_kids[parseKidsKP];
                        parser_real_parse (tree_kids[productionKidsKP], &kidTP);
                        tree_setKidTree (parseKidsKP, kidTP);
                        if ((tree_kids[parseKidsKP] == nilTree) || (currentTokenIndex != oldTokenIndex)) 
                            break;
                    }

                    if (tree_kids[parseKidsKP] != nilTree) {
                        // Got one - now parse a tail
                        treePT kidTP = tree_kids[parseKidsKP + 1];
                        parser_real_parse (tree_kids[productionKidsKP + 1], &kidTP);
                        tree_setKidTree (parseKidsKP + 1, kidTP);
                    } else {
                        // Failed to get a parse - no empty case for [repeat+]
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }
                }
                break;

            case treeKind_generatelist:
                {
                    // New style generate [list] node
                    // (No need to check for infinite parse loop on lists)
                    // (Empty listed items handled automatically now)
                    // (Parse stack gets updated for choose nodes only!)

                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We begin with the first choice.
                    // If it fails, then we take the second (empty) choice.
                    // One or the other always succeeds.

                    // Allocate new parse tree and kids
                    parseKidsKP = tree_newKids (2);
                    *parseTP = tree_newTreeInit (treeKind_list, tree_trees[productionTP].name, tree_trees[productionTP].rawname, 2, parseKidsKP);

                    // Recover wasted space if we end up with the empty case
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Look for a parse of any item
                    treePT kidTP = tree_kids[parseKidsKP];
                    parser_real_parse (tree_kids[productionKidsKP], &kidTP);
                    tree_setKidTree (parseKidsKP, kidTP);

                    if (tree_kids[parseKidsKP] != nilTree) {
                        // Got one - now if we have a separator, parse a tail, otherwise make an empty tail
                        if ((parser_nextTokenKind != treeKind_comment) && (parser_nextToken == comma_T)) {
                            // Look for more
                            parser_accept ();
                            kidTP = tree_kids[parseKidsKP + 1];
                            parser_real_parse (productionTP, &kidTP);
                            tree_setKidTree (parseKidsKP + 1, kidTP);
                            // If the more we got was empty, back off the separator
                            if ((tree_trees[tree_kids[parseKidsKP + 1]].kind == treeKind_list) 
                                    && (tree_trees[tree_kids[(tree_trees[tree_kids[parseKidsKP + 1]].kidsKP) + 1]].kind == treeKind_empty)) {
                                parser_backup ();
                            }
                        } else {
                            // Create an empty tail
                            parseKidTP = tree_newTreeInit (treeKind_list, tree_trees[productionTP].name, 
                                tree_trees[productionTP].rawname, 0, nilKid);
                            tree_makeTwoKids (parseKidTP, emptyTP, emptyTP);
                            tree_setKidTree (parseKidsKP + 1, parseKidTP);
                        }
                    } else {
                        //  We failed to get a parse - but the empty case always succeeds
                        #ifndef NOCOMPILE
                        if (parser_patternParse) {
                            // Allow an [empty] variable binding
                            tree_setKidTree (parseKidsKP, emptyTP);
                            kidTP = tree_kids[parseKidsKP + 1];
                            parser_real_parse (emptyTP, &kidTP);
                            tree_setKidTree (parseKidsKP + 1, kidTP);
                            assert (tree_kids[parseKidsKP + 1] != nilTree);     // variable or not, we can always parse an [empty}
                        } else {
                            tree_setKidTree (parseKidsKP, emptyTP);
                            tree_setKidTree (parseKidsKP + 1, emptyTP);
                        }
                        #else
                        tree_setKidTree (parseKidsKP, emptyTP);
                        tree_setKidTree (parseKidsKP + 1, emptyTP);
                        #endif

                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }
                }
                break;

            case treeKind_list:
                {
                    // New style [list+] node
                    // (No need to check for infinite parse loop on lists)
                    // (Empty listed items handled automatically now)
                    // (Parse stack gets updated for choose nodes only!)

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We must have an item, otherwise list+ fails.

                    // Allocate new parse tree and kids
                    // Name and kind of the parsed node must be the same as for any other list!
                    parseKidsKP = tree_newKids (2);
                    *parseTP = tree_newTreeInit (treeKind_list, tree_trees[tree_kids[productionKidsKP + 1]].name, 
                        tree_trees[tree_kids[productionKidsKP + 1]].rawname, 2, parseKidsKP);

                    // Look for a parse of an item
                    treePT kidTP = tree_kids[parseKidsKP];
                    parser_real_parse (tree_kids[productionKidsKP], &kidTP);
                    tree_setKidTree (parseKidsKP, kidTP);

                    if (tree_kids[parseKidsKP] != nilTree) {
                        // Got one - now if we have a separator, parse a tail, otherwise make an empty tail
                        if ((parser_nextTokenKind != treeKind_comment) && (parser_nextToken == comma_T)) {
                            // Look for more
                            parser_accept ();
                            kidTP = tree_kids[parseKidsKP + 1];
                            parser_real_parse (tree_kids[productionKidsKP + 1], &kidTP);
                            tree_setKidTree (parseKidsKP + 1, kidTP);
                            assert (tree_kids[parseKidsKP + 1] != nilTree);

                            // If the more we got was empty, back off the separator
                            if ((tree_trees[tree_kids[parseKidsKP + 1]].kind == treeKind_list) 
                                    && (tree_trees[tree_kids[tree_trees[tree_kids[parseKidsKP + 1]].kidsKP + 1]].kind == treeKind_empty)) {
                                parser_backup ();
                            }
                        } else {
                            // Create an empty tail
                            parseKidTP = tree_newTreeInit (treeKind_list, tree_trees[tree_kids[productionKidsKP + 1]].name,
                                 tree_trees[tree_kids[productionKidsKP + 1]].rawname, 0, nilKid);
                            tree_makeTwoKids (parseKidTP, emptyTP, emptyTP);
                            tree_setKidTree (parseKidsKP + 1, parseKidTP);
                        }
                    } else {
                        // We failed to get a parse - no empty case for [list+]
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }
                }
                break;

            case treeKind_leftchoose:
                {
                    // Optimized direct left recursion node
                    // (No need to check for infinite parse loop for optimized left recursions)

                    // Update parse stack 
                    if (parser_parseDepth == maxParseDepth) {
                        parser_maxdepth_error ();
                        throw (PARSETOODEEP);
                    }

                    parser_parseDepth += 1;
                    parser_parseStack[parser_parseDepth] = tree_trees[productionTP].name;
                    parser_parseTokenIndex[parser_parseDepth] = currentTokenIndex;

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Since production kids are allocated contiguously,
                    // we can walk through them directly in the kids array.
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We try only the first choice for optimized left recursive productions
                    parseKidTP = nilTree;

                    parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);

                    if (parseKidTP != nilTree) {
                        // Allocate new parse tree and kid
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setKind (*parseTP, treeKind_choose);
                        // Link in the kid we managed to parse
                        tree_makeOneKid (*parseTP, parseKidTP);
                        // Encode the choice we made in the parse tree, in case we must retry
                        tree_setCount (*parseTP, 1);
                    } else {
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }

                    parser_parseDepth -= 1;
                }
                break;

            case treeKind_lookahead:
                {
                    // Check for a lookahead
                    assert (tree_trees[productionTP].count == 2);

                    // Recover wasted space (always!)
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Preserve match stack state
                    oldMatchTop = parser_matchTop;

                    // Let's go!
                    parser_real_parse (tree_kids[tree_trees[productionTP].kidsKP], parseTP);

                    // If we got one, then backup over it - this was just a lookahead
                    if (*parseTP != nilTree) {
                        // Throw away the successful parse
                        parser_backup_tree (*parseTP);
                        // If we were looking for it, we indicate success using the empty tree
                        // otherwise we indicate failure using the usual null tree
                        if (tree_trees[tree_kids[(tree_trees[productionTP].kidsKP) + 1]].name == SEE_T) {
                            *parseTP = emptyTP;
                        } else {
                            *parseTP = nilTree;
                        }
                    } else {
                        // If we were looking for it, we indicate failure using the usual null tree
                        // otherwise we indicate success using the empty tree
                        if (tree_trees[tree_kids[(tree_trees[productionTP].kidsKP) + 1]].name == SEE_T) {
                            if (parser_patternParse) {
                                *parseTP = emptyTP;
                            } else {
                                *parseTP = nilTree;
                            }
                        } else {
                            assert (tree_trees[tree_kids[tree_trees[productionTP].kidsKP + 1]].name == NOT_T); 
                            *parseTP = emptyTP;
                        }
                    }

                    // Always recover the space on a lookahead
                    if (tree_allocationStrategy == simple) {
                        tree_setTreeCount (oldTreeCount);
                        tree_setKidCount (oldKidCount);
                    }

                    // Restore match stack state 
                    parser_matchTop = oldMatchTop;

                    // The empty result indicates success, a null tree indicates failure
                    if (*parseTP != nilTree) {
                        // Allocate a new parse tree for the empty result
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setKind (*parseTP, treeKind_choose);
                        // Link in the empty kid from the production
                        tree_makeOneKid (*parseTP, tree_kids[(tree_trees[productionTP].kidsKP) + 1]);
                        // Encode the choice we made in the parse tree (for lookaheads always 2, the empty result)
                        tree_setCount (*parseTP, 2);
                    }
                }
                break;

            case treeKind_push:
                {
                    // [push X]
                    assert (tree_trees[productionTP].count == 1);

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // See if we have the token we want to push
                    parseKidTP = nilTree;
                    parser_real_parse (tree_kids[tree_trees[productionTP].kidsKP], &parseKidTP);

                    if (parseKidTP != nilTree) {
                        // We do, so build the parent
                        *parseTP = tree_newTreeClone (productionTP);    // sets kind, name and nKids
                        tree_setKind (*parseTP, treeKind_order);           // hide matching from the transformer
                        // Link in the kid we managed to parse
                        tree_makeOneKid (*parseTP, parseKidTP);
                        // And push it to the match stack
                        if (!parser_patternParse) {
                            tokenT pushToken = tree_trees[parseKidTP].name;
                            if ((tree_trees[parseKidTP].kind) != treeKind_id) {
                                if (((tree_trees[parseKidTP].kind == treeKind_charlit) 
                                        && (stringchar (*ident_idents[tree_trees[parseKidTP].name], 1) == '\'')) 
                                    || ((tree_trees[parseKidTP].kind == treeKind_stringlit) 
                                        && (stringchar (*ident_idents[tree_trees[parseKidTP].name], 1) == '"'))) {
                                    parser_installAsId (tree_trees[parseKidTP].name, &pushToken);
                                }
                            }
                            parser_matchPush (pushToken);
                        }
                    } else {
                        // No such luck
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }
                }
                break;

            case treeKind_pop:
                {
                    // [pop X]
                    assert (tree_trees[productionTP].count == 1);

                    // Recover wasted space (always!)
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Let's go!
                    parseKidTP = nilTree;
                    parser_real_parse (tree_kids[tree_trees[productionTP].kidsKP], &parseKidTP);

                    // If we got one, then check it
                    if (parseKidTP != nilTree) {

                        if (parser_patternParse || (tree_trees[parseKidTP].name == parser_matchToken ())) {
                            // It's a successful match, so pop it
                            if (!parser_patternParse) {
                                parser_matchPop ();
                            }
                            // Build the parent
                            *parseTP = tree_newTreeClone (productionTP);        // sets kind, name and nKids
                            tree_setKind (*parseTP, treeKind_order);               // hide matching from transformer
                            // Link in the kid we managed to parse and match
                            tree_makeOneKid (*parseTP, parseKidTP);
                        } else {
                            // This one doesn't match, so throw away the successful parse and don't pop
                            parser_real_parse (tree_kids[tree_trees[productionTP].kidsKP], &parseKidTP);
                            assert (parseKidTP == nilTree);
                            // Recover wasted space
                            if (tree_allocationStrategy == simple) {
                                tree_setTreeCount (oldTreeCount);
                                tree_setKidCount (oldKidCount);
                            }

                            *parseTP = nilTree;
                        }
                    } else {
                        // No such luck
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }
                }
                break;

            // Terminals

            case treeKind_literal:
                {
                    // Don't care what it is, but it must match exactly
                    if ((parser_nextTokenKind != treeKind_comment) && (parser_nextTokenKind != treeKind_empty) 
                            && (parser_nextToken == tree_trees[productionTP].name)) {
                        if (parser_nextRawToken == parser_nextToken) {
                            *parseTP = productionTP;    // we can always share literals
                        } else {
                            *parseTP = tree_newTreeClone (productionTP);        // sets kind and name
                            tree_setRawName (*parseTP, parser_nextRawToken);
                        }

                        parser_accept ();
                    }
                }
                break;

            case treeKind_stringlit: case treeKind_charlit: case treeKind_number: case treeKind_id:
            case treeKind_space: case treeKind_newline:
            case treeKind_usertoken1: case treeKind_usertoken2: case treeKind_usertoken3: case treeKind_usertoken4: case treeKind_usertoken5:
            case treeKind_usertoken6: case treeKind_usertoken7: case treeKind_usertoken8: case treeKind_usertoken9: case treeKind_usertoken10:
            case treeKind_usertoken11: case treeKind_usertoken12: case treeKind_usertoken13: case treeKind_usertoken14: case treeKind_usertoken15:
            case treeKind_usertoken16: case treeKind_usertoken17: case treeKind_usertoken18: case treeKind_usertoken19: case treeKind_usertoken20:
            case treeKind_usertoken21: case treeKind_usertoken22: case treeKind_usertoken23: case treeKind_usertoken24: case treeKind_usertoken25:
            case treeKind_usertoken26: case treeKind_usertoken27: case treeKind_usertoken28: case treeKind_usertoken29: case treeKind_usertoken30:
                {
                    if (parser_nextTokenKind == productionKind) {
                        // accept
                        #ifndef NOCOMPILE
                        if (parser_patternParse) {
                            // Warning - cannot share when compiling because of load/store!
                            *parseTP = tree_newTreeClone ((ident_identTree[parser_nextToken]));
                            tree_setRawName (*parseTP, parser_nextRawToken);
                            tree_setKind (*parseTP, parser_nextTokenKind);
                        } else {
                        #endif
                            // Can always share leaves when parsing
                            if (ident_identTree[parser_nextToken] == nilTree) {
                                // This may happen on a reparse in a compiled program -
                                // the identTree was optimized out by load/store, 
                                // but has come back in a run-time [reparse].  
                                // Correct it by re-installing the token to get a new tree to share.
                                parser_nextToken = ident_install (*ident_idents[parser_nextToken], parser_nextTokenKind);
                            }
                            if ((ident_identTree[parser_nextRawToken]) == nilTree) {
                                // Ditto.
                                parser_nextRawToken = ident_install (*ident_idents[parser_nextRawToken], parser_nextTokenKind);
                            }
                            // Now we can share it for sure
                            assert ((tree_trees[ident_identTree[parser_nextToken]].kind == parser_nextTokenKind)
                                 && (tree_trees[ident_identTree[parser_nextToken]].name == parser_nextToken));
                            if (tree_trees[ident_identTree[parser_nextToken]].rawname == parser_nextRawToken) {
                                *parseTP = ident_identTree[parser_nextToken];
                            } else {
                                // different raw name
                                *parseTP = tree_newTreeClone (ident_identTree[parser_nextToken]);       // sets name and kind
                                tree_setRawName (*parseTP, parser_nextRawToken);
                            }
                        #ifndef NOCOMPILE
                        }
                        #endif

                        parser_accept ();
                    }
                }
                break;

            case treeKind_floatnumber:
                {
                    if ((parser_nextTokenKind == treeKind_number) 
                            && ((lstringindex (*ident_idents[parser_nextToken], "e") != 0) 
                                || (lstringindex (*ident_idents[parser_nextToken], "E") != 0))) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_decimalnumber:
                {
                    if ((parser_nextTokenKind == treeKind_number) 
                            && (lstringindex (*ident_idents[parser_nextToken], ".") != 0) 
                            // and not float
                            && (lstringindex (*ident_idents[parser_nextToken], "e") == 0) 
                            && (lstringindex (*ident_idents[parser_nextToken], "E") == 0)) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_integernumber:
                {
                    if ((parser_nextTokenKind == treeKind_number) 
                            // and not decimal or float
                            && (lstringindex (*ident_idents[parser_nextToken], ".") == 0) 
                            && (lstringindex (*ident_idents[parser_nextToken], "e") == 0) 
                            && (lstringindex (*ident_idents[parser_nextToken], "E") == 0)) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_upperlowerid:
                {
                    if ((parser_nextTokenKind == treeKind_id) 
                            && ((charset_upperP[(unsigned char) (stringchar (*ident_idents[parser_nextToken], 1))]) 
                                || (lstringlen (*ident_idents[parser_nextToken]) == 0))) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_lowerupperid:
                {
                    if ((parser_nextTokenKind == treeKind_id) 
                            && ((charset_lowerP[(unsigned char) (stringchar (*ident_idents[parser_nextToken], 1))]) 
                                || (lstringlen (*ident_idents[parser_nextToken]) == 0))) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_upperid:
                {
                    if ((parser_nextTokenKind == treeKind_id) 
                            && (charset_upperP[(unsigned char) (stringchar (*ident_idents[parser_nextToken], 1))]) 
                            && (charset_uniformlyP (*ident_idents[parser_nextToken], charset_upperidP))) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_lowerid:
                {
                    if ((parser_nextTokenKind == treeKind_id) 
                            && (charset_lowerP[(unsigned char) (stringchar (*ident_idents[parser_nextToken], 1))])
                            && charset_uniformlyP (*ident_idents[parser_nextToken], charset_loweridP)) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_token:
                {
                    // generic token - used only for TXL source itself
                    // anything is ok unless it's a key symbol
                    // whatever it is, it retains its own kind!
                    if ((parser_nextTokenKind != treeKind_key) && (parser_nextTokenKind != treeKind_empty)) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setKind (*parseTP, parser_nextTokenKind);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_key:
                {
                    // generic keyword - used only for TXL source itself
                    if (parser_nextTokenKind == treeKind_key) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setKind (*parseTP, treeKind_literal);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            case treeKind_comment:
                {
                    // optional comment
                    if (parser_nextTokenKind == treeKind_comment) {
                        *parseTP = tree_newTreeClone (productionTP);
                        tree_setName (*parseTP, parser_nextToken);
                        tree_setRawName (*parseTP, parser_nextRawToken);
                        parser_accept ();
                    }
                }
                break;

            // Support for source line number and file name

            case treeKind_srclinenumber:
                {
                    *parseTP = tree_newTree ();
                    tree_setKind (*parseTP, treeKind_srclinenumber);
                    if (parser_patternParse) {
                        tree_setName (*parseTP, nilIdent);
                    } else {
                        tokenT  numberT;
                        parser_installNumber (((inputTokens[currentTokenIndex].linenum) % maxLines), treeKind_number, &numberT);
                        tree_setName (*parseTP, numberT);
                    }
                    tree_setRawName (*parseTP, tree_trees[*parseTP].name);
                }
                break;

            case treeKind_srcfilename:
                {
                    *parseTP = tree_newTree ();
                    tree_setKind (*parseTP, treeKind_srcfilename);
                    if (parser_patternParse) {
                        tree_setName (*parseTP, nilIdent);
                    } else {
                        const tokenT numberT = ident_install (fileNames[inputTokens[currentTokenIndex].linenum / maxLines], treeKind_id);
                        tree_setName (*parseTP, numberT);
                    }
                    tree_setRawName (*parseTP, tree_trees[*parseTP].name);
                }
                break;

            default :
                {
                    parser_fatal_error (1);
                }
                break;
        }

    } else {

        // Backtracking over a previous match
        assert (*parseTP != nilTree);

        #ifdef PROFILER
        parser_backtrackCycles += 1;
        #endif

        switch (productionKind) {

            case treeKind_empty:
                {
                    // Backtracking over a match of empty!!
                    // If this is a keeper, we can't back it up.
                    if (tree_trees[*parseTP].name == KEEP_T) {
                        throw (CUTPOINT);
                    }

                    // If this is a fence [!], then we have failed this sequence
                    if (tree_trees[*parseTP].name == FENCE_T) {
                        parser_fenceState = 1;
                    }

                    *parseTP = nilTree;
                }
                break;

            case treeKind_order:
                {
                    // Retrying an order sequence
                    productionKids = tree_trees[productionTP].count;
                    assert (productionKids > 0);

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Since they are contiguous, we can just run up and down
                    // the production kid lists directly!
                    baseProductionKidsKP = tree_trees[productionTP].kidsKP - 1;

                    // Since we allocate the kids of the parse contiguously, 
                    // we can use them in place too!
                    baseParseKidsKP = tree_trees[*parseTP].kidsKP - 1;

                    // Now we parse!

                    // If we are backtracking, we start at the last kid of the previous parse
                    // and retry working backwards.
                    retry = true;
                    int kid = productionKids;

                    // Let's go!
                    while (true) {
                        oldTokenIndex = currentTokenIndex;

                        treePT kidTP = tree_kids[baseParseKidsKP + kid];
                        parser_real_parse (tree_kids[baseProductionKidsKP + kid], &kidTP);
                        tree_setKidTree (baseParseKidsKP + kid, kidTP);

                        if (tree_kids[baseParseKidsKP + kid] == nilTree) {
                            // Retry another match of the previous kid
                            kid -= 1;
                            if (kid < 1) break;
                            retry = true;

                            // If we backtracked into a fence, we've failed the sequence
                            if (parser_fenceState) break;

                        } else if ((!retry) || (currentTokenIndex != oldTokenIndex)) {
                            // Go on to the next one
                            kid += 1;
                            if (kid > productionKids) break;
                            retry = false;
                            tree_setKidTree (baseParseKidsKP + kid, nilTree);   // first try

                        // } else {
                            // Re-parses of an embedded kid that yield the
                            // same lookahead are uninteresting since the
                            // rest will fail in the same way!
                            //  - so just ask for another try of the same kid
                        }
                    }

                    // We fail if we're at the left, succeed if we made it all the way to the right

                    if (kid > 0) {
                        // Successful backtrack - everything has already been previously built!
                        if (parser_fenceState) {
                            // Hit a fence - we must undo the partial parse and fail
                            while (true) {
                                if (kid == 0) break;
                                parser_backup_tree (tree_kids[baseParseKidsKP + kid]);
                                kid -= 1;
                            }
                            // Failed to get a parse
                            *parseTP = nilTree;
                            // Recover wasted space
                            if (tree_allocationStrategy == simple) {
                                tree_setTreeCount (oldTreeCount);
                                tree_setKidCount (oldKidCount);
                            }
                        }
                    } else {
                        // Failed to get a parse
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }

                    // Reset the fence flag
                    parser_fenceState = false;
                }
                break;

            case 1:
                {
                    // Retrying a regular choose tree

                    // update parse stack (for choose trees only!)
                    assert (parser_parseDepth < maxParseDepth);  // must be so, if we are retrying!

                    parser_parseDepth += 1;
                    parser_parseStack[parser_parseDepth] = tree_trees[productionTP].name;
                    parser_parseTokenIndex[parser_parseDepth] = 0;

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Total number of alternatives we have
                    productionKids = tree_trees[productionTP].count;

                    // Since production kids are allocated contiguously,
                    // we can walk through them directly in the kids array.
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // Since we are backtracking, parseTP is the previous parse and
                    // tree.trees (parseTP).count encodes the number of the choice we used last time.
                    // First we give that one a chance to retry, then try the other 
                    // alternatives if it fails.
                    parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];
                    kidLastTime = tree_trees[*parseTP].count;

                    // Since kids are allocated contiguously, we can address the 
                    // corresponding production kid directly
                    productionKidsKP = ((tree_trees[productionTP].kidsKP) + kidLastTime) - 1;

                    // Since we are retrying, not much use exploring same tail ...
                    oldTokenIndex = currentTokenIndex;

                    // Try each alternative until we get a new match
                    int kid = kidLastTime;
                    while (true) {

                        parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);

                        if (parseKidTP != nilTree) {
                            if (currentTokenIndex != oldTokenIndex) {
                                // Got another one! 
                                // We re-use the tree and kid structure we allocated on the first try
                                tree_setKidTree (tree_trees[*parseTP].kidsKP, parseKidTP);
                                // Encode the new choice we made in the parse tree,
                                // in case we must retry again
                                tree_setCount (*parseTP, kid);
                                break;
                            } else {
                                // Re-parses that yield the same lookahead are uninteresting since the
                                // rest will fail in the same way!
                                //  - so just ask for another try of the same alternative
                            }
                        } else {
                            // Try the next alternative
                            if (kid == productionKids) break;
                            kid += 1;
                            productionKidsKP += 1;
                            parser_parseTokenIndex[parser_parseDepth] = currentTokenIndex;
                        }
                    }

                    if (parseKidTP == nilTree) {
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    } else if (currentTokenIndex == oldTokenIndex) {
                        parser_backup_tree (parseKidTP);
                        *parseTP = nilTree;
                    }

                    parser_parseDepth -= 1;
                }
                break;

            case treeKind_generaterepeat:
                {
                    // Retrying a new-style [repeat] node
                    
                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // If the previous parse was an [empty] repeat, there is nothing to do but fail.
                    if (tree_kids[tree_trees[*parseTP].kidsKP] == emptyTP) {
                        #ifndef NOCOMPILE
                        if (parser_patternParse) {
                            if (tree_kids[tree_trees[*parseTP].kidsKP + 1] != emptyTP) {
                                assert ((tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_firstTime)
                                     || (tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_subsequentUse)
                                     || (tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_expression));
                                parser_backup ();

                                #ifndef NOCOMPILE
                                    // If the variable we are backing up over was a binding occurence,
                                    // undo the binding
                                    if (tree_trees[tree_kids[(tree_trees[*parseTP].kidsKP) + 1]].kind == treeKind_firstTime) {
                                        rule_unenterLocalVar (parser_parseContext, parser_patternVarsAddr,
                                            tree_trees[tree_kids[(tree_trees[*parseTP].kidsKP) + 1]].name);
                                    }
                                #endif
                            }
                        } else {
                            assert (tree_kids[tree_trees[*parseTP].kidsKP + 1] == emptyTP);
                        }
                        #else
                        assert (tree_kids[tree_trees[*parseTP].kidsKP + 1] == emptyTP);
                        #endif

                        *parseTP = nilTree;

                        #ifndef NOCOMPILE
                        if (options_option[tree_print_p]) {
                            parser_trace_exit (productionTP, *parseTP);
                        }
                        #endif

                        return;
                    }

                    // update parse stack (for choose/generate trees only!)
                    parser_parseDepth += 1;
                    parser_parseStack[parser_parseDepth] = tree_trees[productionTP].name;
                    // Important - need to be sure that we know we were this far ...
                    parser_parseTokenIndex[parser_parseDepth] = currentTokenIndex;

                    // Otherwise, we first retry the tail, then the item.
                    // If it fails, then we replace it by the empty choice.
                    // One or the other always succeeds.
                    retry = false;

                    while (true) {
                        // Since we are backtracking, parseTP is the previous parse.
                        parseKidTP = tree_kids[(tree_trees[*parseTP].kidsKP) + 1];

                        // No use exploring the same case ...
                        oldTokenIndex = currentTokenIndex;

                        // Retry the tail
                        while (true) {
                            parser_real_parse (productionTP, &parseKidTP);
                            if ((parseKidTP == nilTree) || (currentTokenIndex != oldTokenIndex) || retry) break;
                        }

                        if (parseKidTP != nilTree) break;

                        // No new parse of the tail - try for a new parse of the item
                        parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];

                        // No use exploring the same case, or empty items ...
                        oldTokenIndex = currentTokenIndex;

                        while (true) {
                            // Retry the item
                            parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);
                            if ((parseKidTP == nilTree) || ((currentTokenIndex != oldTokenIndex) && (!parser_is_empty (parseKidTP)))) 
                                break;
                        }

                        if (parseKidTP == nilTree) break;

                        // Got a new item - now looking for a new tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP, parseKidTP);
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, nilTree);
                        retry = true;
                    }

                    if (parseKidTP == nilTree) {
                        // We failed to get any interesting new parse - but the empty case always succeeds
                        tree_setKidTree (tree_trees[*parseTP].kidsKP, emptyTP);
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, emptyTP);
                    } else {
                        // Got an interesting new parse of the tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, parseKidTP);
                    }

                    parser_parseDepth -= 1;
                }
                break;

            case treeKind_repeat:
                {
                    // Retrying a new style [repeat+] node

                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We must have an item, otherwise repeat+ fails.

                    // No empty items allowed ...
                    oldTokenIndex = currentTokenIndex;

                    // First we retry the tail, then the item.
                    // If it fails, then we must fail since at least one item is required.
                    retry = false;

                    while (true) {
                        // Since we are backtracking, parseTP is the previous parse.
                        parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP + 1];

                        // No use exploring the same case ...
                        oldTokenIndex = currentTokenIndex;

                        // Retry the tail
                        while (true) {
                            parser_real_parse (tree_kids[productionKidsKP + 1], &parseKidTP);
                            if ((parseKidTP == nilTree) || (currentTokenIndex != oldTokenIndex) || retry) break;
                        }

                        if (parseKidTP != nilTree) break;
                        
                        // No new parse of the tail - try for a new parse of the item
                        parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];

                        // No use exploring the same case, or empty items ...
                        oldTokenIndex = currentTokenIndex;

                        while (true) {
                            // Retry the item
                            parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);
                            if ((parseKidTP == nilTree) || ((currentTokenIndex != oldTokenIndex) && (!parser_is_empty (parseKidTP)))) 
                                break;
                        }

                        if (parseKidTP == nilTree) break;

                        // Got a new item - now looking for a new tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP, parseKidTP);
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, nilTree);
                        retry = true;
                    }

                    if (parseKidTP == nilTree) {
                        // We failed to get any interesting new parse of an item - so we must fail
                        *parseTP = nilTree;
                    } else {
                        // Got an interesting new parse of the tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, parseKidTP);
                    }
                }
                break;

            case treeKind_generatelist:
                {
                    // Retrying a new-style generate [list] node
                    
                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // If the previous parse was an [empty] list, there is nothing to do but fail.
                    if (tree_kids[tree_trees[*parseTP].kidsKP] == emptyTP) {
                        #ifndef NOCOMPILE
                        if (parser_patternParse) {
                            if ((tree_kids[(tree_trees[*parseTP].kidsKP) + 1]) != emptyTP) {
                                assert ((tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_firstTime)
                                     || (tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_subsequentUse)
                                     || (tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_expression));
                                parser_backup ();

                                #ifndef NOCOMPILE
                                    // If the variable we are backing up over was a binding occurence,
                                    // undo the binding
                                    if (tree_trees[tree_kids[(tree_trees[*parseTP].kidsKP) + 1]].kind == treeKind_firstTime) {
                                        rule_unenterLocalVar (parser_parseContext, parser_patternVarsAddr,
                                            tree_trees[tree_kids[(tree_trees[*parseTP].kidsKP) + 1]].name);
                                    }
                                #endif
                            }
                        } else {
                            assert (tree_kids[tree_trees[*parseTP].kidsKP + 1] == emptyTP);
                        }
                        #else
                        assert (tree_kids[tree_trees[*parseTP].kidsKP + 1] == emptyTP);
                        #endif

                        *parseTP = nilTree;

                        #ifndef NOCOMPILE
                        if (options_option[tree_print_p]) {
                            parser_trace_exit (productionTP, *parseTP);
                        }
                        #endif

                        return;
                    }

                    // Otherwise, we first retry the tail, then the item.
                    // If it fails, then we replace it by the empty choice.
                    // One or the other always succeeds.
                    retry = false;

                    // Keep track of whether we originally had a comma 
                    bool hadComma = ((tree_trees[*parseTP].kind == treeKind_list) 
                        && ((!(tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_list)) 
                           || (tree_trees[tree_kids[tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kidsKP + 1]].kind != treeKind_empty)));

                    while (true) {
                        // Since we are backtracking, parseTP is the previous parse.
                        parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP + 1];

                        // No use exploring the same case ...
                        oldTokenIndex = currentTokenIndex;

                        // Retry the tail
                        while (true) {
                            parser_real_parse (productionTP, &parseKidTP);
                            if ((parseKidTP == nilTree) || (currentTokenIndex != oldTokenIndex) || retry) break;
                        }

                        if (parseKidTP != nilTree) break;

                        // No new parse of the tail - backup the separator comma, then try for a new parse of the item
                        if (hadComma) {
                            parser_backup ();
                        }

                        // We are no longer holding an implicit comma
                        hadComma = false;

                        // Try for a new parse of the item 
                        parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];

                        // No use exploring the same case ...
                        oldTokenIndex = currentTokenIndex;

                        while (true) {
                            // Retry the item
                            parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);
                            if ((parseKidTP == nilTree) || (currentTokenIndex != oldTokenIndex)) break;
                        }

                        if (parseKidTP == nilTree) break;

                        // Link in the new item
                        tree_setKidTree (tree_trees[*parseTP].kidsKP, parseKidTP);

                        // If we have a separator comma, parse a new tail, otherwise make an empty tail
                        if ((parser_nextTokenKind != treeKind_comment) && (parser_nextToken == comma_T)) {
                            parser_accept ();
                            hadComma = true;

                        } else {
                            // Create an empty tail and we're done
                            parseKidTP = tree_newTreeInit (treeKind_list, tree_trees[productionTP].name, tree_trees[productionTP].rawname, 
                                0, nilKid);
                            tree_makeTwoKids (parseKidTP, emptyTP, emptyTP);
                            break;
                        }

                        // Got a separator comma - parse a new tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, nilTree);
                        retry = true;
                    }

                    if (parseKidTP == nilTree) {
                        // We failed to get any interesting new parse - but the empty case always succeeds
                        tree_setKidTree (tree_trees[*parseTP].kidsKP, emptyTP);
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, emptyTP);
                        if (hadComma) {
                            assert ((currentTokenIndex > 0) && (inputTokens[currentTokenIndex - 1].token == comma_T));
                            parser_backup ();
                        }
                    } else {
                        // Got an interesting new parse of the tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, parseKidTP);
                        if ((tree_trees[parseKidTP].kind == treeKind_list) 
                                && (tree_trees[tree_kids[(tree_trees[parseKidTP].kidsKP) + 1]].kind == treeKind_empty) && hadComma) {
                            if ((currentTokenIndex > 0) && (inputTokens[currentTokenIndex - 1].token == comma_T)) {
                                parser_backup ();
                            }
                            assert (parser_nextToken == comma_T);
                        }
                    }
                }
                break;

            case treeKind_list:
                {
                    // Retrying a new style list+ node

                    // The generated item type
                    productionKidsKP = tree_trees[productionTP].kidsKP;

                    // We must have an item, otherwise list+ fails.
                    assert (tree_trees[*parseTP].kind == treeKind_list);

                    // First we retry the tail, then the item.
                    // If it fails, then we must fail since at least one item is required.
                    retry = false;

                    // Keep track of whether we originally had a comma 
                    bool hadComma = ((tree_trees[*parseTP].kind == treeKind_list) 
                        && ((!(tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kind == treeKind_list)) 
                           || (tree_trees[tree_kids[tree_trees[tree_kids[tree_trees[*parseTP].kidsKP + 1]].kidsKP + 1]].kind != treeKind_empty)));

                    while (true) {
                        // Since we are backtracking, parseTP is the previous parse.
                        parseKidTP = tree_kids[(tree_trees[*parseTP].kidsKP) + 1];

                        // No use exploring the same case ...
                        oldTokenIndex = currentTokenIndex;

                        // Retry the tail
                        while (true) {
                            parser_real_parse (tree_kids[productionKidsKP + 1], &parseKidTP);
                            if ((parseKidTP == nilTree) || (currentTokenIndex != oldTokenIndex) || retry) break;
                        }

                        if (parseKidTP != nilTree) break;

                        // No new parse of the tail - backup the separator comma, then try for a new parse of the item
                        if (hadComma) {
                            assert ((currentTokenIndex > 0) && (inputTokens[currentTokenIndex].token == comma_T));
                            parser_backup ();
                        }

                        // We are no longer holding an implicit comma
                        hadComma = false;

                        // Try for a new parse of the item 
                        parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];

                        // No use exploring the same case ...
                        oldTokenIndex = currentTokenIndex;

                        while (true) {
                            // Retry the item
                            parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);
                            if ((parseKidTP == nilTree) || (currentTokenIndex != oldTokenIndex)) break;
                        }

                        if (parseKidTP == nilTree) break;

                        // Link in the new item
                        tree_setKidTree (tree_trees[*parseTP].kidsKP, parseKidTP);

                        if ((parser_nextTokenKind != treeKind_comment) && (parser_nextToken == comma_T)) {
                            parser_accept ();
                            hadComma = true;
                        } else {
                            // Create an empty tail and we're done
                            parseKidTP = tree_newTreeInit (treeKind_list, tree_trees[tree_kids[productionKidsKP + 1]].name, 
                                tree_trees[tree_kids[productionKidsKP + 1]].rawname, 0, nilKid);
                            tree_makeTwoKids (parseKidTP, emptyTP, emptyTP);
                            break;
                        }

                        // Got a separator - parse a new tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, nilTree);
                        retry = true;
                    }

                    if (parseKidTP == nilTree) {
                        // We failed to get any interesting new parse of an item - so we must fail
                        if (hadComma) {
                            assert ((currentTokenIndex > 0) && (inputTokens[currentTokenIndex].token == comma_T));
                            parser_backup ();
                        }
                        *parseTP = nilTree;

                    } else {
                        // Got an interesting new parse of the tail
                        tree_setKidTree (tree_trees[*parseTP].kidsKP + 1, parseKidTP);
                        if ((tree_trees[parseKidTP].kind == treeKind_list) 
                                && (tree_trees[tree_kids[(tree_trees[parseKidTP].kidsKP) + 1]].kind == treeKind_empty) && hadComma) {
                            if ((currentTokenIndex > 0) && ((inputTokens[currentTokenIndex - 1].token) == comma_T)) {
                                parser_backup ();
                            }
                            assert (parser_nextToken == comma_T);
                        }
                    }
                }
                break;

            case treeKind_leftchoose:
                {
                    // Retrying an optimized left recursive choose tree

                    // update parse stack (for choose trees only!)
                    assert (parser_parseDepth < maxParseDepth);  // must be so, if we are retrying!

                    parser_parseDepth += 1;
                    parser_parseStack[parser_parseDepth] = tree_trees[productionTP].name;
                    parser_parseTokenIndex[parser_parseDepth] = 0;

                    // Recover wasted space if we fail
                    oldKidCount = tree_kidCount;
                    oldTreeCount = tree_treeCount;

                    // Left recursive chooses always have exactly 2 choices
                    assert (tree_trees[productionTP].count == 2);

                    // Since we are backtracking, parseTP is the previous parse and
                    // tree.trees (parseTP).count encodes the number of the choice we used last time.
                    // If tree.trees (parseTP).count is greater than the number of choices,
                    // we've already tried to extend it.
                    kidLastTime = tree_trees[*parseTP].count;
        
                    // Optimization of direct left recursive productions to avoid 
                    // infinite backtracking loops.  The define compiler has reduced 
                    // all direct left recursions to the form:
                    //  E  ->  E1               
                    //    |  E E2               

                    // Can we optimize?
                    if ((kidLastTime <= 2) 
                            #ifndef NOCOMPILE
                                || isVarOrExp
                            #endif
                            ) {
                        // Haven't tried to extend this one yet ...
                        // so try extending our present parse from the bottom up.
                        // We have:  parseTP  ->  E  ->  E1 
                        // We want:  parseTP  ->  E'  ->  E E2
                        productionKidsKP = tree_trees[productionTP].kidsKP;
                        parseKidTP = *parseTP;

                        // Try to extend previously parsed E with an E2
                        // tree.kids (productionKidsKP + 1) is the grammar for E  ->  E E2
                        // parseKidTP is initially our previously parsed E, and on return our extended E  ->  E E2, if any
                        parser_parse_extend (tree_kids[productionKidsKP + 1], &parseKidTP);

                        if (parseKidTP != nilTree) {
                            // Bottom up extension worked! 
                            // Mark the embedded tree as already extended in case we back up over it.
                            #ifndef NOCOMPILE
                            if (!isVarOrExp) {
                                tree_setCount (*parseTP, tree_trees[productionTP].count + 1);
                            }
                            #else
                            tree_setCount (*parseTP, tree_trees[productionTP].count + 1);
                            #endif

                            // Must allocate new tree and kid for the extended parse!
                            *parseTP = tree_newTreeClone (productionTP);
                            tree_setKind (*parseTP, treeKind_choose);
                            tree_makeOneKid (*parseTP, parseKidTP);

                            // Remember which alternative we chose last time.
                            tree_setCount (*parseTP, 2);

                            // Rename trees to give specified parse (even though we got it using left factoring) - JRC 8.5.08
                            // We lift the name (e.g. expn  ->  addition (expn + term) ) 
                            // from the left-factored form (e.g., expn  ->  expn addition (+ term) )
                            // and give the left-factored form the anonymous name instead.
                            treePT anonorderTP = tree_kids[tree_trees[*parseTP].kidsKP];
                            treePT leftfactoredTP = tree_kids[tree_trees[tree_kids[(tree_trees[anonorderTP].kidsKP) + 1]].kidsKP];

                            // Use redundancy of rawname to swap without a temporary
                            tree_setName (anonorderTP, tree_trees[leftfactoredTP].rawname);
                            tree_setName (leftfactoredTP, tree_trees[anonorderTP].rawname);
                            tree_setRawName (anonorderTP, tree_trees[anonorderTP].name);
                            tree_setRawName (leftfactoredTP, tree_trees[leftfactoredTP].name);

                        } else {
                            // Attempt to extend failed - 
                            // Nothing to do but retry the original parse.

                            #ifndef NOCOMPILE
                            if (isVarOrExp) {
                                // If an extension of a pattern var failed, simply back up over it
                                parser_backup ();

                                #ifndef NOCOMPILE
                                    // If the variable we are backing up over was a binding occurence,
                                    // undo the binding
                                    if (tree_trees[*parseTP].kind == treeKind_firstTime) {
                                        rule_unenterLocalVar (parser_parseContext, parser_patternVarsAddr,
                                            tree_trees[*parseTP].name);
                                    }
                                #endif

                                // No other parse possible, so give up
                                *parseTP = nilTree;
                                // Recover wasted space
                                if (tree_allocationStrategy == simple) {
                                    tree_setTreeCount (oldTreeCount);
                                    tree_setKidCount (oldKidCount);
                                }

                            } else {
                            #endif
                                // Retry the original parse
                                parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];
                                productionKidsKP += kidLastTime - 1;

                                parser_real_parse (tree_kids[productionKidsKP], &parseKidTP);

                                if (parseKidTP != nilTree) {
                                    // Another parse of the original case - 
                                    // we re-use the old tree and kid structure.
                                    tree_setKidTree (tree_trees[*parseTP].kidsKP, parseKidTP);
                                    // Same choice this time
                                    #ifndef NOCOMPILE
                                        assert (!isVarOrExp);
                                    #endif
                                    tree_setCount (*parseTP, kidLastTime);

                                } else {
                                    // No new parse, so give up
                                    *parseTP = nilTree;
                                    // Recover wasted space
                                    if (tree_allocationStrategy == simple) {
                                        tree_setTreeCount (oldTreeCount);
                                        tree_setKidCount (oldKidCount);
                                    }
                                }
                            #ifndef NOCOMPILE
                            }
                            #endif
                        }

                    } else {
                        // Already tried extending - nothing to do but give up.
                        // NOTE: In this particular case, we cannot retry the parse since
                        // that is the infinite loop we are avoiding!  The side effect
                        // of this is that we have to back up over all of the accepted tokens
                        // in the parse tree at once.  'backup_tree' does this.
                        parser_backup_tree (*parseTP);
                        *parseTP = nilTree;
                        // Recover wasted space
                        if (tree_allocationStrategy == simple) {
                            tree_setTreeCount (oldTreeCount);
                            tree_setKidCount (oldKidCount);
                        }
                    }

                    parser_parseDepth -= 1;
                }
                break;

            case treeKind_lookahead:
                {
                    // Retrying a lookahead - just fail back
                    *parseTP = nilTree;
                }
                break;

            case treeKind_push:
                {
                    // Retrying a push - nothing to do but pop the match token and retry
                    tokenT prevMatchToken = empty_T;
                    if (!parser_patternParse) {
                        prevMatchToken = parser_matchToken ();
                        parser_matchPop ();
                    }

                    // This reparse will always fail, but we must do it in case it's a variable definition in a pattern
                    parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];
                    parser_real_parse ((tree_kids[tree_trees[productionTP].kidsKP]), &parseKidTP);
                    assert (parseKidTP == nilTree);

                    if (!parser_patternParse) {
                        assert (parser_nextToken == prevMatchToken);
                    }

                    *parseTP = nilTree;
                }
                break;

            case treeKind_pop:
                {
                    // Retrying a pop - nothing to do but retry and push the match token 
                    
                    // This reparse will always fail, but we must do it in case it's a variable definition in a pattern
                    parseKidTP = tree_kids[tree_trees[*parseTP].kidsKP];
                    parser_real_parse (tree_kids[tree_trees[productionTP].kidsKP], &parseKidTP);
                    assert (parseKidTP == nilTree);

                    if (!parser_patternParse) {
                        parser_matchPush (parser_nextToken);
                    }

                    *parseTP = nilTree;
                }
                break;

            case treeKind_srclinenumber: case treeKind_srcfilename:
                {
                    // Retrying a source coordinate - just fail and retry above
                    *parseTP = nilTree;
                }
                break;

            case treeKind_literal: case treeKind_stringlit: case treeKind_charlit: case treeKind_token:
            case treeKind_id: case treeKind_upperlowerid: case treeKind_upperid: case treeKind_lowerupperid: case treeKind_lowerid:
            case treeKind_number: case treeKind_floatnumber: case treeKind_decimalnumber: case treeKind_integernumber:
            case treeKind_key: case treeKind_comment: case treeKind_space: case treeKind_newline:
            case treeKind_usertoken1: case treeKind_usertoken2: case treeKind_usertoken3: case treeKind_usertoken4: case treeKind_usertoken5:
            case treeKind_usertoken6: case treeKind_usertoken7: case treeKind_usertoken8: case treeKind_usertoken9: case treeKind_usertoken10:
            case treeKind_usertoken11: case treeKind_usertoken12: case treeKind_usertoken13: case treeKind_usertoken14: case treeKind_usertoken15:
            case treeKind_usertoken16: case treeKind_usertoken17: case treeKind_usertoken18: case treeKind_usertoken19: case treeKind_usertoken20:
            case treeKind_usertoken21: case treeKind_usertoken22: case treeKind_usertoken23: case treeKind_usertoken24: case treeKind_usertoken25:
            case treeKind_usertoken26: case treeKind_usertoken27: case treeKind_usertoken28: case treeKind_usertoken29: case treeKind_usertoken30:
                {
                    // Retrying a terminal - only thing left to do is back up!
                    if ((currentTokenIndex <= 0) 
                            || (!((!(productionKind == treeKind_literal)) 
                                 || (tree_trees[*parseTP].name == inputTokens[currentTokenIndex - 1].token)))) {
                        parser_fatal_error (2);
                    }

                    *parseTP = nilTree;
                    parser_backup ();
                }
                break;

            default :
                {
                    parser_fatal_error (3);
                }
                break;
        }
    }

    #ifndef NOCOMPILE 
    if (options_option[tree_print_p]) {
        parser_trace_exit (productionTP, *parseTP);
    }
    #endif

    #ifdef PROFILER 
    if (parser_mainParse && (tree_trees[productionTP].kind < treeKind_empty)) {
        const int symbolIndex = symbol_findSymbol (tree_trees[productionTP].name);
        struct parser_symbolStatisticsT *symbolStats = &(parser_symbolStatistics[symbolIndex]);
        symbolStats -> calls += 1;
        if (parseTP != nilTree) {
            symbolStats -> matches += 1;
        }
        symbolStats -> parsecycles = oldStats -> parsecycles + (parser_parseCycles - startStats -> parsecycles);
        symbolStats -> backtrackcycles = oldStats -> backtrackcycles + (parser_backtrackCycles - startStats -> backtrackcycles);
        symbolStats -> trees = oldStats -> trees + (tree_treeCount - startStats -> trees);
        symbolStats -> kids = oldStats -> kids + (tree_kidCount - startStats -> kids);
    }
    #endif
}

#ifdef PROFILER

static void parser_write_profile (void) {
    int profout;
    tfopen (OPEN_CHAR_WRITE, "txl.pprofout", &profout);

    if (profout != 0) {
        fprintf (tffile (profout), "name calls matches parsecycles backtrackcycles trees kids\n");

        for (int r = 1; r <= symbol_nSymbols; r++) {
            string symbolname;
            stringcpy (symbolname, *ident_idents[tree_trees[symbol_symbols[r]].name]);

            if ((tree_trees[symbol_symbols[r]].kind < treeKind_empty) 
                    && (stringncmp (symbolname, "__", 2) != 0)         // internal type
                    && (stringncmp (symbolname, "lit_", 4) != 0)       // terminal literal
                    && (stringncmp (symbolname, "opt__", 5) != 0)      // covered by opt'ed type
                    && (stringncmp (symbolname, "repeat_1_", 9) != 0)  // covered by repeat_0_
                    && (stringncmp (symbolname, "list_1_", 7) != 0)    // covered by list_0_
                ) {
                struct parser_symbolStatisticsT *symbolStats = &(parser_symbolStatistics[r]);
                if ((stringncmp (symbolname, "repeat_0_", 9) == 0) || (stringncmp (symbolname, "list_0_", 7) == 0)) {
                    int zindex = stringindex (symbolname, "_0_");
                    string preZ, postZ;
                    substring (preZ, symbolname, 1, zindex);
                    substring (postZ, symbolname, zindex + 2, lstringlen (symbolname));
                    stringcpy (symbolname, preZ), stringcat (symbolname, postZ);
                }
                fprintf (tffile (profout), "%s %d %d %d %d %d %d\n", symbolname, 
                    symbolStats -> calls, symbolStats -> matches, symbolStats -> parsecycles,
                    symbolStats -> backtrackcycles, symbolStats -> trees, symbolStats -> kids);
            }
        }

    } else {
        error("", "Unable to create TXL profile file 'txl.pprofout'", FATAL, 129);
    }

    tfclose (profout);
}
#endif

void parser_parse (const treePT productionTP, treePT *parseTP)
{
    try {
        // Initialize hard limit on parse
        parser_parseCycles = 0;

        #ifdef PROFILER
        for (int r = 1; r <= symbol_nSymbols; r++) {
            struct parser_symbolStatisticsT *symbolStats = &(parser_symbolStatistics[r]);
            symbolStats -> calls = 0;
            symbolStats -> matches = 0;
            symbolStats -> parsecycles = 0;
            symbolStats -> backtrackcycles = 0;
            symbolStats -> trees = 0;
            symbolStats -> kids = 0;
        }
        parser_backtrackCycles = 0;
        #endif

        *parseTP = nilTree;
        while (true) {
            parser_real_parse (productionTP, parseTP);
            if ((currentTokenIndex == lastTokenIndex) || (*parseTP == nilTree)) break;
        }

        if (currentTokenIndex != lastTokenIndex) {
            *parseTP = nilTree;
        }

        #ifdef PROFILER
        if (parser_mainParse) {
            parser_write_profile();
        }
        #endif

    } catch {

        if ((exception == OUTOFKIDS) || (exception == OUTOFTREES) || (exception == PARSETOODEEP) 
                || (exception == CUTPOINT) || (exception == CYCLELIMIT)) {
            *parseTP = nilTree;
            #ifdef PROFILER
            // this may be useful (or not!)
            parser_write_profile();
            #endif
            return;
        } else if (exception == INTERRUPT) {
            parseInterruptError (failTokenIndex, parser_patternParse, parser_parseContext);
        } else if (exception == STACKLIMIT) {
            parseStackError (failTokenIndex, parser_patternParse, parser_parseContext);
        } else if (exception != QUIT) {
            error (parser_parseContext, "Fatal TXL error in parse (signal)", DEFERRED, 130);
        }
        throw (exception);
    }
}

// Initialization
void parser (void) {
    // parseStack - 1-origin [0 .. maxParseDepth]
    arrayalloc (maxParseDepth + 1, int, parser_parseStack);
    arrayalloc (maxParseDepth + 1, tokenIndexT, parser_parseTokenIndex);
    parser_parseDepth = 0;
    parser_maxRecursionTokenIndex = -1;

    // global state variables
    parser_txlParse = false;
    parser_patternParse = false;
    stringcpy (parser_parseContext, "");
    parser_fenceState = false;
    parser_lastEmptyWarningTP = nilTree;
    parser_parseCycles = 0;

    // matchStack - 1-origin [1 .. maxParseDepth]
    arrayalloc (maxParseDepth + 1, tokenT, parser_matchStack);
    parser_matchStack[0] = UNUSED;
    parser_matchTop = 0;

#ifdef PROFILER
    parser_mainParse = false;
    // symbolStatistics - 1-origin [1 .. maxSymbols]
    arrayalloc (maxSymbols + 1, struct parser_symbolStatisticsT, parser_symbolStatistics);

    // parseSymbolStatistics - 1-orign [1 .. maxParseDepth]
    arrayalloc (maxParseDepth + 1, struct parser_symbolStatisticsT, parser_startStatistics);
    arrayalloc (maxParseDepth + 1, struct parser_symbolStatisticsT, parser_oldStatistics);
#endif
}
